; Génération de code

;Retourne une liste de paires contenant les paramètres avec leur position dans la pile
;par rapport à FP
;
;(make-env '(x y z)) ---->  ((x.-4)(y.-3)(z.-2))
(defun make-env (largs)
  (labels ((aux (l n)
                (if (null l)
                  l
                  (cons (cons (car l) (- n))
                        (aux (cdr l) (1- n))))))
    (aux largs (1+ (length largs)))))


(defun map-lisp-to-vm (expr env uni)
  (if (atom expr) nil
    (append (lisp-to-vm (car expr) env uni)
            (map-lisp-to-vm (cdr expr) env uni))))

(defun addR0 (expr)
  `( ,@expr (PUSH R0)))

(defun lisp-to-vm (expr env uni)
  ;Cas d'expression d'un litteral
  (cond ((and (atom expr) (constantp expr)) `((move (lit ,expr) R0)))
        ; Cas d'expression d'une variable
        ((or (atom expr) (symbolp expr)) `((load ,`(FP ,(cdr (assoc expr env)) ) R0 )))
        ; La soustraction
        ((eq '- (car expr)) `(,@(lisp-to-vm (cadr expr) env uni)
                               (PUSH R0)
                               ,@(lisp-to-vm (caddr expr) env uni)
                               (POP R1)
                               (SUB R1 R0)))
        ;L'addition
        ((eq '+ (car expr)) `(,@(lisp-to-vm (cadr expr) env uni)
                               (PUSH R0)
                               ,@(lisp-to-vm (caddr expr) env uni)
                               (POP R1)
                               (ADD R1 R0)))
        ; La multiplication
        ((eq '* (car expr)) `(,@(lisp-to-vm (cadr expr) env uni)
                               (PUSH R0)
                               ,@(lisp-to-vm (caddr expr) env uni)
                               (POP R1)
                               (MULT R1 R0)))
        ; Cas d'un if avec comparaison et expression arithmétique
        ((eq 'if (car expr))
         `(,@(lisp-to-vm (cadadr expr) env uni)
            (PUSH R0)
            ,@(lisp-to-vm (caddr (cadr expr)) env uni)
            (POP R1)
            (COMP R1 R0)
            (,(cond ((or (eq (caadr expr) '=) (eq (caadr expr) 'eq)) 'JEQ)
                    ((eq (caadr expr) '<) 'JPP)
                    ((eq (caadr expr) '>) 'JPG)
                    ((eq (caadr expr) '<=) 'JPE)
                    ((eq (caadr expr) '>=) 'JGE )
                    ('ERREUR_SAUT)) oui,uni)
            ,@(lisp-to-vm (cadddr expr) env (+ 1 uni))
            (JMP fin,uni)
            (ETIQ oui,uni)
            ,@(lisp-to-vm (caddr expr) env (+ 1 uni))
            (ETIQ fin,uni)))

        ; Expression du defun
        ((eq 'defun (car expr))
         `((ETIQ ,(cadr expr))
           ,@(lisp-to-vm (cadddr expr) (make-env (caddr expr)) uni)
            (rtn)))
        ; Appel de fonction
        ((fboundp (car expr))
         `(,@(funcall #'addR0 (map-lisp-to-vm (cdr expr) env uni))
            (PUSH (LIT ,(length (cdr expr))))
            (MOVE SP R2)
            (DECR R2)
            (DECR R2)
            (PUSH R2)
            (PUSH FP)
            (JSR ,(car expr))
            (POP FP)
            (POP SP)))


        ( () )))

(defun fact (n)
  (if (= n 0) 1
    (* n (fact (1- n)))))
(defun fibo (n) (if (<= n 1) 1 (+ (fibo (- n 1)) (fibo (- n 2)))))


